home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1995-04-22 | 6.8 KB | 271 lines |
- Screen Open 0,640,200,4,$8000
- Curs Off : Flash Off : Paper 0 : Pen 1 : Cls
- Palette 0,$FFF,$F00,$F0,$F,$F0F,$FF0,$FF,$222,$F80,$F8
- Dim REGS(10)
- Global GOT$,LVO,RES,LIB$,LIB,FUNK,BASE,REGS()
- LVO=0 : DIO=0
- CLEARALL
- TRACK$="trackdisk.device"+Chr$(0)
- Gosub INIT
- Gosub OPENDEVICE
- If RES Then Print "Error opening "+TRACK$+"!!!" : CLOSALL : End
- Reserve As Work 12,1760*516
- BIGBASE=Start(12)
- Reserve As Work 11,1760
- BITST=Start(11)
- Reserve As Work 10,512*11
- AD=Start(10)
- STT=0
- Gosub MOTORON
- A=0
- OS=880*512 : LE=512
- Gosub REEDBLOCK
- If Leek(AD+312)<>-1 Then Print "Disk not validated!" : Gosub QUIT : End
- BITMAP=Leek(AD+316)
- Print "Bitmapblock:";BITMAP
- OS=BITMAP*512 : LE=512
- Gosub REEDBLOCK
- USED=0
- X=0 : Y=0
- For A=0 To 1759
- P=Leek(AD+(A+30)/32*4)
- B=Btst((A+30) mod 32,P)
- If A/2=0 Then B=0
- If B=0 Then Inc USED
- Poke BITST+A,B+1
- Ink B+2
- Bar(A/22)*8,(A mod 22)*8 To(A/22)*8+6,(A mod 22)*8+6
- Next
- Print "Blocks used:";USED
- LX=BIGBASE
- For A=0 To 1759
- If Peek(BITST+A)=1 Then Gosub CRUNCHNSAVE
- If Inkey$<>"" Then Exit
- Next
- Bsave "ram:Disk.dcr",BIGBASE To LX
- Gosub QUIT
- End
- CRUNCHNSAVE:
- Doke LX,A : Add LX,2
- OS=A*512 : LE=512 : Gosub REEDBLOCK
- Copy AD,AD+512 To AD+512
- UN= Extension_5_00CE(AD+512,512,1,2048,0)
- If UN<1
- Print "Block";A;" not crunched!"
- Doke LX,$FFFF : Add LX,2
- Copy AD,AD+512 To LX : Add LX,512
- Else
- Print "Block";A;" crunched to";UN;" bytes len!"
- Doke LX,UN : Add LX,2
- Copy AD+512,AD+512+UN To LX : Add LX,UN
- End If
- Return
- QUIT:
- Gosub MOTOROFF
- Gosub CLOSDEVICE
- CLOSALL
- Return
- INIT:
- LAUFWERK=0
- Reserve As Chip Work 9,128
- OPENLIB["exec"]
- LIPCALL1["exec","FindTask",0]
- TASK=RES
- ST=Start(9)
- For A=1 To Len(TRACK$)
- Poke ST+89+A,Asc(Mid$(TRACK$,A,1))
- Next
- TRACK=ST+90
- DISKPORT=ST
- Loke ST,0 : Loke ST+4,0 : Doke ST+8,$400 : Loke ST+10,0
- Doke ST+14,31 : Loke ST+16,TASK : Loke ST+20,ST+24
- Loke ST+24,0 : Loke ST+28,ST+20 : Doke ST+32,0
- DISKIO=ST+34
- Loke ST+34,0 : Loke ST+38,0 : Doke ST+42,$500 : Loke ST+44,0
- Loke ST+48,DISKPORT : Doke ST+52,48
- For A=0 To 8
- Loke ST+54+A*4,0
- Next
- Return
- OPENDEVICE:
- DIO=0
- LIPCALL4["exec","OpenDevice",TRACK,LAUFWERK,DISKIO,0]
- Return
- MOTORON:
- Doke DISKIO+28,9
- Loke DISKIO+36,1
- If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
- Return
- MOTOROFF:
- Doke DISKIO+28,9
- Loke DISKIO+36,0
- If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
- Return
- REEDBLOCK:
- Doke DISKIO+28,2
- Loke DISKIO+36,LE
- Loke DISKIO+40,AD
- Loke DISKIO+44,OS
- If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
- Return
- CLOSDEVICE:
- DIO=0
- LIPCALL1["exec","CloseDevice",DISKIO]
- Return
- End
- Procedure LIPCALL0[N$,F$]
- LIB$=N$ : LIBGET[F$]
- LCALL
- End Proc
- Procedure LIPCALL1[N$,F$,R1]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1
- LCALL
- End Proc
- Procedure LIPCALL2[N$,F$,R1,R2]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2
- LCALL
- End Proc
- Procedure LIPCALL3[N$,F$,R1,R2,R3]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3
- LCALL
- End Proc
- Procedure LIPCALL4[N$,F$,R1,R2,R3,R4]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4
- LCALL
- End Proc
- Procedure LIPCALL5[N$,F$,R1,R2,R3,R4,R5]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- LCALL
- End Proc
- Procedure LIPCALL6[N$,F$,R1,R2,R3,R4,R5,R6]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- REGS(6)=R6
- LCALL
- End Proc
- Procedure LIPCALL7[N$,F$,R1,R2,R3,R4,R5,R6,R7]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- REGS(6)=R6 : REGS(7)=R7
- LCALL
- End Proc
- Procedure LIPCALL8[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8
- LCALL
- End Proc
- Procedure LIPCALL9[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9
- LCALL
- End Proc
- Procedure LIPCALL10[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10]
- LIB$=N$ : LIBGET[F$]
- REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
- REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9 : REGS(10)=R10
- LCALL
- End Proc
- Procedure LIBGET[FUNK$]
- ST=Start(15) : LIBS=Leek(ST)
- LIB$=LIB$-".library"+".library"
- FUNK$=Upper$(FUNK$)
- For A=1 To LIBS
- BIN[ST+Leek(ST+A*8-4)]
- If LIB$=GOT$ Then Exit
- Next
- If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End
- If Leek(ST+A*8)=0 Then Print "FEHLER: Library nicht offen!" : End
- LIB=A
- BASE=ST+Leek(ST+A*8-4)
- For A=1 To Deek(BASE+24)
- BIN[BASE-12+A*44-LVO*4]
- If Upper$(GOT$)=FUNK$ Then Exit
- Next
- If A=Deek(BASE+24)+1 Then Print "FEHLER: Funktion nicht gefunden!" : End
- FUNK=A
- End Proc
- Procedure LCALL
- For A=1 To 8
- R=Peek(BASE+17+A+FUNK*44)
- If R>0 Then Loke Start(14)+R*4-4,REGS(A)
- Next
- OFF=-Deek(BASE+16+FUNK*44)
- Loke Start(14)+60,Leek(Start(15)+LIB*8)+OFF
- Loke Start(14)+56,Leek(Start(15)+LIB*8)
- Call Start(14)+64
- RES=Leek(Start(14))
- End Proc
- Procedure OPENLIB[N$]
- If Length(15)=0
- Open In 1,"dh1:amos/fertig/libcall/LibCall.dat" : L=Lof(1) : GOT$=Input$(1,8) : Close 1
- Reserve As Data 15,L
- Bload "dh1:amos/fertig/libcall/LibCall.dat",15
- End If
- ST=Start(15) : LIBS=Leek(ST)
- N$=N$-".library"+".library"
- For A=1 To LIBS
- BIN[ST+Leek(ST+A*8-4)]
- If N$=GOT$ Then Exit
- Next
- If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End
- If Leek(ST+A*8)<>0 Then Pop Proc
- If N$="exec.library" Then Loke ST+A*8,Leek(4) : Pop Proc
- Areg(1)=ST+Leek(ST+A*8-4)
- Dreg(0)=0
- Loke ST+A*8,Execall(-552)
- If Leek(ST+A*8)=0 Then Print "FEHLER: Library konnte nicht ge�ffnet werden!" : End
- End Proc
- Procedure CLEARALL
- If Length(15)=0 Then Pop Proc
- ST=Start(15)
- For A=1 To Leek(ST)
- Loke ST+A*8,0
- Next
- End Proc
- Procedure CLOSLIB[N$]
- If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
- ST=Start(15) : LIBS=Leek(ST)
- N$=N$-".library"+".library"
- For A=1 To LIBS
- BIN[ST+Leek(ST+A*8-4)]
- If N$=GOT$ Then Exit
- Next
- If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End
- If Leek(ST+A*8)=0 Then Pop Proc
- If N$="exec.library" Then Loke ST+A*8,0 : Pop Proc
- Areg(1)=Leek(ST+A*8)
- AD=Execall(-414)
- Loke ST+A*8,0
- End Proc
- Procedure CLOSALL
- If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
- ST=Start(15) : LIBS=Leek(ST)
- For A=1 To LIBS
- BIN[ST+Leek(ST+A*8-4)]
- If(GOT$<>"exec.library") and(Leek(ST+A*8)<>0)
- Areg(1)=Leek(ST+A*8)
- AD=Execall(-414)
- Loke ST+A*8,0
- Else
- Loke ST+A*8,0
- End If
- Next
- End Proc
- Procedure GEREG[REGNUM]
- RES=Leek(Start(14)+REGNUM*4)
- End Proc
- Procedure BIN[AD]
- GOT$=""
- Do
- CO=Peek(AD) : Inc AD
- Exit If CO=0
- GOT$=GOT$+Chr$(CO)
- Loop
- End Proc